home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
tjgold.zip
/
INSTALL.001
/
GOLDMEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-12
|
102KB
|
3,243 lines
{--------------------------------------------------------------------------}
{ Product: TechnoJock's Turbo Toolkit }
{ Version: GOLD }
{ Build: 1.01 }
{ }
{ Copyright 1986-1995 TechnoJock Software, Inc. }
{ All Rights Reserved }
{ Restricted by License }
{--------------------------------------------------------------------------}
{**********************************}
{** Unit: GOLDMEMO **}
{**********************************}
{++++++++++++++++++++++++++++++} unit GOLDMEMO; {++++++++++++++++++++++++++++}
{$I GOLDFLAG.INC}
{$IFNDEF GOLDMEMO}
{$DEFINE GOLDMEMO}
{$ENDIF}
{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
uses DOS, CRT, GoldHard, GoldMisc, GoldTint, GoldIO, GoldStr,
GoldKey, GoldFast, GoldWin, GoldLink, GoldList;
const
FirstMemoCol = MemoHi;
LastMemoCol = MemoIcons;
type
MemoCfgPtr = ^MemoCfg;
MemoGetLineFunc = function(MP:MemoCfgPtr;LineNum: longint): string;
MemoSetLineFunc = procedure(MP:MemoCfgPtr;LineNum: longint;Str:string);
MemoDelLineFunc = procedure(MP:MemoCfgPtr;LineNum: longint);
MemoInsLineFunc = function(MP:MemoCfgPtr;LineNum: longint):longint;
MemoInsModeFunc = procedure(Insert:boolean);
MemoCharHook = procedure(MP:MemoCfgPtr;var Code:word; var X,Y:byte);
MemoHindHook = procedure(MP:MemoCfgPtr);
MemoCloseProc = function(MemoDetails:MemoCfgPtr; Handle:integer):boolean;
MemoTints = array[FirstMemoCol..LastMemoCol] of byte;
ClipboardPtr = ^ClipBoardBuffer;
ClipboardBuffer = record
TotalParagraphs: integer;
LineList: SingleLL;
FullLastLine: boolean;
end; {ClipboardBuffer}
MemoCfg = record
DataSource: pointer;
DataType: ListDataSource;
LeftGap,RightGap,BotGap,TopGap: byte;
LineStr: string; {copy of line being edited}
WX1,WY1,WX2,WY2,WStyle: byte;
WiType: WinType;
TotalNodes: longint;
TopNode: longint;
CursorPosX: byte;
TargetPosX: byte; {target X position when down or up pressed}
CursorPosY: byte;
BlockX1: byte;
BlockY1: longint;
BlockX2: byte;
BlockY2: longint;
FirstCharPos: byte;
MaxWidth: byte;
MaxLines: byte;
AllowEdits: boolean;
WordWrap: boolean;
InWindow: boolean;
DrawVScroll: boolean;
InsertOn: boolean;
UsingArray: boolean;
WarningGiven: boolean;
IsDirty: boolean;
Col: MemoTints;
GetLine: MemoGetLineFunc;
SetLine: MemoSetLineFunc;
DelLine: MemoDelLineFunc;
InsLine: MemoInsLineFunc;
InsMode: MemoInsModeFunc;
CharHook: MemoCharHook;
HindHook: MemoHindHook;
StrLength: byte; {length of string element when editing an array}
{header/footer related}
Headers: array[1..ListMaxHeaders] of ^string;
ScrollHeader: boolean;
Footers: array[1..ListMaxFooters] of ^string;
ScrollFooter: boolean;
{internal}
X1,Y1,X2,Y2,YH: byte; {dimensions of list (including headings)}
{desk - internal}
DeskMemoCloseCallBack: MemoCloseProc;
end; {MemoCfg}
MemoSet = record
LastECode: integer;
WordRightKey: word;
WordLeftKey: word;
TopOfWindowKey: word;
BotOfWindowKey: word;
TopofMemoKey: word;
BotofMemoKey: word;
DeltoScrapKey: word;
DelBlockKey: word;
CopyToScrapkey: word;
InsfromScrapKey: word;
MarkBlockStartKey: word;
MarkBlockEndKey: word;
HideBlockKey: word;
EndofParaCode: char;
EndEditKey: word;
EscEditKey: word;
WinStyle:byte;
WType: WinType;
WX1: byte; {dimensions of window}
WY1: byte;
WX2: byte;
WY2: byte;
DefaultLineLength: byte;
ECode: integer;
Clipboard: ClipboardPtr;
{Messages}
ClipboardMsgTitle:string[40];
WarningTitle: string[20];
ClipboardNoMemoryMsg: string[70];
ClipboardLowMemoryMsg: string[70];
ClipboardLineFullMsg: string[70];
MaxLinesMsg: string[50];
MemoNearlyFullMsg: string[100];
WordwrapoffMsg: string[80];
LineFullMsg: string[100];
end; {MemoSet}
procedure MemoSetError(ECode:integer);
function LastMemoError: integer;
{heading management}
procedure MemoAssignHeader(var MemoDetails: MemoCfg; Line:byte; var Heading:string);
procedure MemoAssignFooter(var MemoDetails: MemoCfg; Line:byte; var Footnote:string);
procedure MemoRemoveHeader(var MemoDetails: MemoCfg; Line:byte);
procedure MemoRemoveFooter(var MemoDetails: MemoCfg; Line:byte);
procedure MemoScrollHeader(var MemoDetails: MemoCfg; On:boolean);
procedure MemoScrollFooter(var MemoDetails: MemoCfg; On:boolean);
{misc settings}
procedure MemoAssignHindHook(var MemoDetails: MemoCfg; Proc:MemoHindHook);
procedure MemoAssignCharHook(var MemoDetails: MemoCfg; Proc:MemoCharHook);
procedure MemoRemoveHindHook(var MemoDetails: MemoCfg);
procedure MemoRemoveCharHook(var MemoDetails: MemoCfg);
procedure MemoSetWordWrap(var MemoDetails: MemoCfg; On:boolean);
procedure MemoSetDirty(var MemoDetails: MemoCfg; On:boolean);
function MemoIsDirty(var MemoDetails: MemoCfg):boolean;
procedure MemoSetWin(var MemoDetails: MemoCfg; X1,Y1,X2,Y2:integer; Style:byte);
procedure MemoSetGaps(var MemoDetails: MemoCfg; LeftGap,RightGap,BotGap,TopGap: byte);
procedure MemoSetColor(var MemoDetails: MemoCfg; A:TintElement;C:byte);
procedure MemoStoreActiveLine(var MemoDetails: MemoCfg);
{$IFDEF WORDWRAP}
procedure WrapFullNoSpaces(var MemoDetails: MemoCfg);
procedure WrapFull(var MemoDetails: MemoCfg);
procedure CursorUp(var MemoDetails: MemoCfg);
{$ENDIF}
procedure InitMemoCfg(var MemoDetails: MemoCfg);
procedure MemoAssignSLL(var MemoDetails: MemoCfg; var MemoSource: SingleLL);
procedure MemoReAssignSLL(var MemoDetails: MemoCfg; var MemoSource: SingleLL);
procedure MemoAssignDLL(var MemoDetails: MemoCfg; var MemoSource: DoubleLL);
procedure MemoAssignArray(var MemoDetails: MemoCfg; var MemoSource; StrLen:Byte;ArrayElements:byte);
procedure RunMemo(var MemoDetails: MemoCfg; Tit:StrScreen);
function LaunchMemo(var MemoDetails: MemoCfg;Tit:StrScreen; CloseProc:MemoCloseProc): byte;
{internals}
procedure TurnBlockOff(var MemoDetails:MemoCfg);
procedure MemoProcessKey(var MemoDetails: MemoCfg;var K:word;X,Y:byte);
procedure DisplayMemo(var MemoDetails:MemoCfg; Status:gStatus);
procedure MoveCursor(var MemoDetails: MemoCfg);
procedure MemoSetDirtyFlag(var MemoDetails: MemoCfg);
{$IFDEF CUTANDPASTE}
procedure ClearClipboardBuffer;
{$ENDIF}
var
MemoVars: MemoSet;
{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
const
NilLine: string[6] = ' gold ';
{$IFDEF CUTANDPASTE}
var
Marking: boolean;
AtBlockStart,
AtBlockEnd: boolean;
{$ENDIF}
procedure MemoSetError(ECode:integer);
{}
{$IFOPT D+}
var Msg: string;
{$ENDIF}
begin
MemoVars.LastEcode := ECode;
{$IFOPT D+}
case ECode of
1001 : Msg := 'Unable to create the edit window';
0: exit;
end; {case}
if PromptCustom(' GoldMemo Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
Halt;
{$ENDIF}
end; {MemoSetError}
function LastMemoError: integer;
{}
begin
LastMemoError := MemoVars.LastECode;
end; { LastMemoError }
procedure MemoWarning(ID:integer);
{}
begin
case ID of
1: PromptOK(MemoVars.ClipboardMsgTitle,MemoVars.ClipboardNoMemoryMsg);
2: PromptOK(MemoVars.ClipboardMsgTitle,MemoVars.ClipboardLowMemoryMsg);
3: PromptOK(MemoVars.WarningTitle,MemoVars.WordwrapoffMsg);
4: PromptOK(MemoVars.WarningTitle,MemoVars.ClipboardLineFullMsg);
5: PromptOK(MemoVars.WarningTitle,MemoVars.MaxLinesMsg);
6: PromptOK(MemoVars.WarningTitle,MemoVars.MemoNearlyFullMsg);
end;
end; { MemoWarning }
{**********************************}
{** Generic Callback Functions **}
{**********************************}
{$IFOPT F-}
{$DEFINE FOFF}
{$F+}
{$ENDIF}
procedure NoMemoCharHook(MP:MemoCfgPtr;var Code:word; var X,Y:byte);
{}
begin
end; { NoMemoCharHook }
procedure NoMemoHindHook(MP:MemoCfgPtr);
{}
begin
end; { NoMemoHindHook }
function DummyGetLine(MP:MemoCfgPtr;LineNum: longint): string;
{abstract}
begin
DummyGetLine := '';
end; { DummyGetLine }
procedure DummySetLine(MP:MemoCfgPtr;LineNum: longint;Str:string);
{abstract}
begin
end; { DummySetLine }
procedure DummyDelLine(MP:MemoCfgPtr;LineNum: longint);
{abstract}
begin
end; { DummyDelLine }
function DummyInsLine(MP:MemoCfgPtr;LineNum: longint):longint;
{abstract}
begin
DummyInsLine := 0;
end; { DummyInsLine }
procedure DummyInsProc(Insert:boolean);
{}
begin
if Insert then
CursorOn
else
CursorFull;
end; { DummyInsProc }
{******************************}
{** SLL Callback Functions **}
{******************************}
function SLLGetLine(MP:MemoCfgPtr;LineNum: longint): string;
{}
begin
SLLGetLine := _SLLGetNodeStr(SingleLL(MP^.DataSource^),_SLLNodePtr(SingleLL(MP^.DataSource^),LineNum),250);
end; { SLLGetLine }
function SLLInsLine(MP:MemoCfgPtr;LineNum: longint):longint;
{}
begin
if LineNum > SingleLL(MP^.DataSource^).TotalNodes then
begin
if _SllInsStrBefore(SingleLL(MP^.DataSource^),nil,'') <> 0 then
{oh well}
end
else if _SllInsStrBefore(SingleLL(MP^.DataSource^),_SLLNodePtr(SingleLL(MP^.DataSource^),LineNum),'') <> 0 then
{oh well};
SLLInsLine := SingleLL(MP^.DataSource^).TotalNodes
end; { SLLInsLine }
procedure SLLSetLine(MP:MemoCfgPtr;LineNum:longint;Str:string);
{}
begin
if LineNum = succ(MP^.TotalNodes) then {really adding a line}
if SLLInsLine(MP,LineNum) = 0 then
exit;
if _SLLChangeStr(SingleLL(MP^.DataSource^),_SLLNodePtr(SingleLL(MP^.DataSource^),LineNum),Str) <> 0 then
{oh well};
end; { SLLSetLine }
procedure SLLDelLine(MP:MemoCfgPtr;LineNum: longint);
{}
begin
_SLLDelNode(SingleLL(MP^.DataSource^),_SLLNodePtr(SingleLL(MP^.DataSource^),LineNum));
end; { SLLDelLine }
{******************************}
{** DLL Callback Functions **}
{******************************}
function DLLGetLine(MP:MemoCfgPtr;LineNum: longint): string;
{}
begin
DLLGetLine := DLLGetNodeStr(DLLNodePtr(LineNum),0,0);
end; { DLLGetLine }
procedure DLLSetLine(MP:MemoCfgPtr;LineNum:longint;Str:string);
{}
begin
if DLLChange(DLLNodePtr(LineNum),Str,succ(length(Str))) <> 0 then
{oh well};
end; { DLLSetLine }
procedure DLLDelLine(MP:MemoCfgPtr;LineNum: longint);
{}
begin
DLLDelNode(DLLNodePtr(LineNum));
end; { DLLDelLine }
function DLLInsLine(MP:MemoCfgPtr;LineNum: longint):longint;
{}
var Str: string;
begin
Str := '';
if LineNum > LinkVars.ActiveDLL^.TotalNodes then
begin
if DLLInsertBefore(nil,Str,0) <> 0 then
{oh well}
end
else if DLLInsertBefore(DLLNodePtr(LineNum),Str,1) <> 0 then
{oh well};
DLLInsLine := LinkVars.ActiveDLL^.TotalNodes
end; { DLLInsLine }
{********************************}
{** Array Callback Functions **}
{********************************}
function ArrayGetLine(MP:MemoCfgPtr;LineNum: longint): string;
{}
var W: longint;
TempStr: String;
ArrayOffset: word;
begin
if (LineNum < 1) or (LineNum > MP^.MaxLines) then
ArrayGetLine := ''
else
begin
{move array string to Temp}
W := pred(LineNum) * succ(MP^.StrLength);
ArrayOffset := Ofs(MP^.DataSource^) + W;
move(Mem[Seg(MP^.DataSource^):ArrayOffset],TempStr,1);
move(Mem[Seg(MP^.DataSource^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
ArrayGetLine := TempStr;
end;
end; { ArrayGetLine }
procedure ArraySetLine(MP:MemoCfgPtr;LineNum:longint;Str:string);
{}
var W: longint;
ArrayOffset: word;
Len: byte;
begin
if (LineNum >= 1) and (LineNum <= MP^.MaxLines) then
begin
{move array string to Temp}
W := pred(LineNum) * succ(MP^.StrLength);
ArrayOffset := Ofs(MP^.DataSource^) + W;
Len := succ(length(Str));
if Len <= MP^.StrLength then
move(Str[0],mem[Seg(MP^.DataSource^):ArrayOffset],Len)
else
begin
Str := copy(Str,1,MP^.StrLength);
move(Str[0],mem[Seg(MP^.DataSource^):ArrayOffset],succ(length(Str)));
end;
end;
end; { ArraySetLine }
procedure ArrayDelLine(MP:MemoCfgPtr;LineNum: longint);
{}
var W: longint;
ArrayOffset: word;
Null: char;
begin
if (LineNum >= 1) and (LineNum < MP^.MaxLines) then
begin
W := pred(LineNum) * succ(MP^.StrLength);
ArrayOffset := Ofs(MP^.DataSource^) + W;
move(mem[Seg(MP^.DataSource^):ArrayOffset+succ(MP^.StrLength)],
Mem[Seg(MP^.DataSource^):ArrayOffset],
(MP^.MaxLines - LineNum)*succ(MP^.StrLength));
{empty last line}
W := pred(MP^.MaxLines) * succ(MP^.StrLength);
ArrayOffset := Ofs(MP^.DataSource^) + W;
Null := char(0);
move(Null,Mem[seg(MP^.DataSource^):ArrayOffset],1);
end;
end; { ArrayDelLine }
function ArrayInsLine(MP:MemoCfgPtr;LineNum: longint):longint;
{}
var W: longint;
ArrayOffset: word;
Null: char;
begin
if (LineNum >= 1) and (LineNum < MP^.MaxLines) then
begin
W := pred(LineNum) * succ(MP^.StrLength);
ArrayOffset := Ofs(MP^.DataSource^) + W;
move(mem[Seg(MP^.DataSource^):ArrayOffset],
Mem[Seg(MP^.DataSource^):ArrayOffset+succ(MP^.StrLength)],
(MP^.MaxLines - LineNum)*succ(MP^.StrLength));
{empty new line}
Null := char(0);
move(Null,Mem[seg(MP^.DataSource^):ArrayOffset],1);
if succ(MP^.TotalNodes) > MP^.MaxLines then
ArrayInsLine := MP^.MaxLines
else
ArrayInsLine := succ(MP^.TotalNodes);
end
else
ArrayInsLine := MP^.TotalNodes;
end; { ArrayInsLine }
{$IFDEF FOFF}
{$F-}
{$UNDEF FOFF}
{$ENDIF}
procedure InitMemoCfg(var MemoDetails: MemoCfg);
{}
var
A: TintElement;
I: integer;
begin
fillchar(MemoDetails,sizeof(MemoDetails),#0);
with MemoDetails do
begin
DataSource := nil;
DataType := SourceUnknown;
LineStr := NilLine;
X1 := 1;
Y1 := 1;
X2 := 60;
Y2 := 15;
WiType := MemoVars.WType;
WStyle := MemoVars.WinStyle;
TotalNodes := 0;
TopNode := 0;
CursorPosX := 1;
TargetPosX := 0;
CursorPosY := 1;
BlockX1 := 1;
BlockY1 := 1;
BlockX2 := 1;
BlockY2 := 1;
FirstCharPos := 1;
MaxWidth := 120;
MaxLines := 0;
AllowEdits := true;
WordWrap := true;
InWindow := false;
DrawVScroll := true;
WarningGiven := false;
InsertOn := true;
UsingArray := false;
IsDirty := false;
for A := FirstMemoCol to LastMemoCol do
Col[A] := Tint[A];
GetLine := DummyGetLine;
SetLine := DummySetLine;
DelLine := DummyDelLine;
InsLine := DummyInsLine;
InsMode := DummyInsProc;
CharHook := NoMemoCharHook;
HindHook := NoMemoHindHook;
{header/footer stuff}
for I := 1 to ListMaxHeaders do
Headers[I] := nil;
ScrollHeader := true;
for I := 1 to ListMaxFooters do
Footers[I] := nil;
ScrollFooter := true;
end;
end; { InitMemoCfg }
procedure MemoSetWordWrap(var MemoDetails: MemoCfg; On:boolean);
{}
begin
Memodetails.WordWrap := On;
end; {MemoSetWordWrap}
procedure MemoSetDirty(var MemoDetails: MemoCfg; On:boolean);
{}
begin
Memodetails.IsDirty := On;
end; {MemoSetWordWrap}
function MemoIsDirty(var MemoDetails: MemoCfg):boolean;
{}
begin
MemoIsDirty := Memodetails.IsDirty;
end; {MemoSetWordWrap}
procedure MemoSetWin(var MemoDetails: MemoCfg; X1,Y1,X2,Y2:integer; Style:byte);
{}
begin
MemoDetails.WX1 := X1;
MemoDetails.WY1 := Y1;
MemoDetails.WX2 := X2;
MemoDetails.WY2 := Y2;
MemoDetails.WStyle := Style;
end; { MemoSetWin }
procedure MemoSetGaps(var MemoDetails: MemoCfg; LeftGap,RightGap,BotGap,TopGap: byte);
{}
begin
MemoDetails.LeftGap := LeftGap;
MemoDetails.RightGap := RightGap;
MemoDetails.BotGap := BotGap;
MemoDetails.TopGap := TopGap;
end; { MemoSetGaps }
procedure MemoSetColor(var MemoDetails: MemoCfg; A:TintElement;C:byte);
{}
begin
if A in [FirstMemoCol..LastMemoCol] then
MemoDetails.Col[A] := C;
end; { MemoSetColor }
procedure MemoAssignHindHook(var MemoDetails: MemoCfg; Proc:MemoHindHook);
{}
begin
MemoDetails.HindHook := Proc;
end; { MemoAssignHindHook }
procedure MemoAssignCharHook(var MemoDetails: MemoCfg; Proc:MemoCharHook);
{}
begin
MemoDetails.CharHook := Proc;
end; { MemoAssignCharHook }
procedure MemoRemoveCharHook(var MemoDetails: MemoCfg);
{}
begin
MemoDetails.CharHook := NoMemoCharHook;
end; { MemoRemoveCharHook }
procedure MemoRemoveHindHook(var MemoDetails: MemoCfg);
{}
begin
MemoDetails.HindHook := NoMemoHindHook;
end; { MemoRemoveHindHook }
procedure MemoStoreActiveLine(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
end; {MemoStoreActiveLine}
procedure MemoAssignSLL(var MemoDetails: MemoCfg; var MemoSource: SingleLL);
{}
begin
InitMemoCfg(MemoDetails);
with MemoDetails do
begin
TotalNodes := MemoSource.TotalNodes;
TopNode := 1;
DataSource := @MemoSource;
DataType := SourceSLL;
GetLine := SLLGetLine;
SetLine := SLLSetLine;
DelLine := SLLDelLine;
InsLine := SLLInsLine;
end;
end; { MemoAssignSLL }
procedure MemoReAssignSLL(var MemoDetails: MemoCfg; var MemoSource: SingleLL);
begin
with MemoDetails do
begin
TotalNodes := MemoSource.TotalNodes;
TopNode := 1;
DataSource := @MemoSource;
LineStr := NilLine;
end;
end; { MemoReAssignSLL }
procedure MemoAssignDLL(var MemoDetails: MemoCfg; var MemoSource: DoubleLL);
{}
begin
InitMemoCfg(MemoDetails);
with MemoDetails do
begin
TotalNodes := MemoSource.TotalNodes;
TopNode := 1;
DataSource := @MemoSource;
DataType := SourceDLL;
GetLine := DLLGetLine;
SetLine := DLLSetLine;
DelLine := DLLDelLine;
InsLine := DLLInsLine;
end;
end; { MemoAssignDLL }
procedure MemoAssignArray(var MemoDetails: MemoCfg; var MemoSource; StrLen:Byte;ArrayElements:byte);
{}
begin
InitMemoCfg(MemoDetails);
with MemoDetails do
begin
UsingArray := true;
MaxLines := ArrayElements;
TotalNodes := ArrayElements;
TopNode := 1;
DataSource := @MemoSource;
DataType := SourceArray;
GetLine := ArrayGetLine;
SetLine := ArraySetLine;
DelLine := ArrayDelLine;
InsLine := ArrayInsLine;
StrLength := StrLen;
end;
end; { MemoAssignArray }
{*********************}
{** Display Procs **}
{*********************}
procedure MemoSetDirtyFlag(var MemoDetails: MemoCfg);
{INTERNAL}
begin
Memodetails.LineStr := NilLine;
end; {MemoSetDirtyFlag}
function BlockActive(var MemoDetails:MemoCfg): boolean;
{}
begin
with MemoDetails do
BlockActive := (BlockY2 > BlockY1)
or
((BlockX2 > BlockX1) and (BlockY1 = BlockY2));
end; { BlockActive }
procedure MemoWriteVScrollBar(var MemoDetails:MemoCfg; Status:gStatus);
{}
var A: byte;
begin
with MemoDetails do
if DrawVScroll then
begin
if (TotalNodes > succ(Y2-Y1)) or (TopNode > 1) then {need a scroll bar}
begin
if Status in [Activate,HiStatus] then
A := Col[MemoScrollbarHi]
else
A := Col[MemoScrollbarNorm];
WriteVScrollBar(X2,Y1,Y2,A,pred(TopNode)+CursorPosY,TotalNodes);
end else {clear the scroll bar area}
begin
if Status in [Activate,HiStatus] then
A := Col[MemoHi]
else
A := Col[MemoNorm];
WriteVert(X2,Y1,A,replicate(succ(Y2-Y1),' '));
end;
end;
end; { MemoWriteVScrollBar }
procedure MemoWriteLineInBlock(var MemoDetails:MemoCfg;var Str:string;LineNum:longint);
{The passed string is already padded and adjusted for the display window}
var StartX,EndX: integer; {block start X and block end X}
begin
with MemoDetails do
begin
if ((BlockY1 < LineNum) or (BlockX1 <= FirstCharPos))
and ((BlockY2 > LineNum) or (BlockX2 >= FirstCharPos + X2-X1)) then {whole visible line is part of block}
WriteAT(X1,Y1+LineNum-TopNode,Col[MemoBlock],
padleft(copy(Str,FirstCharPos,255),succ(X2-X1) - ord(DrawVScroll),' '))
else {part of line is in block}
begin
if (BlockY1 < LineNum) or (BlockX1 <= FirstCharPos) then
StartX := 1
else
StartX := BlockX1 - pred(FirstCharPos);
if (BlockY2 > LineNum) or (BlockX2 >= FirstCharPos+ X2-X1) then
EndX := FirstCharPos + succ(X2-X1)
else
EndX := BlockX2 - pred(FirstCharPos);
if StartX > 1 then {write the non block-part}
WriteAT(X1,Y1+LineNum-TopNode,Col[MemoHi],copy(Str,1,StartX));
WriteAT(pred(X1) + StartX,Y1+LineNum-TopNode,Col[MemoBlock],
copy(Str,StartX,EndX - StartX));
if (EndX < FirstCharPos + X2-X1) then
WriteAT(pred(X1)+EndX,Y1+LineNum-TopNode,Col[MemoHi],
copy(Str,EndX,X2-X1-EndX+2));
end;
end;
end; { MemoWriteLineInBlock }
procedure MemoWriteLineStr(var MemoDetails:MemoCfg);
{}
var CursY: longint;
begin
with MemoDetails do
begin
CursY := Pred(TopNode) + CursorPosY;
if BlockActive(MemoDetails) and (BlockY1 <= CursY) and (BlockY2 >= CursY) then {this line is part of block}
MemoWriteLineInBlock(MemoDetails,LineStr,pred(TopNode+CursorPosY))
else
WriteAT(X1,Y1+pred(CursorPosY),Col[MemoHi],
padleft(copy(LineStr,FirstCharPos,255),succ(X2-X1) - ord(DrawVScroll),' '));
end;
end; { MemoWriteLineStr }
procedure MemoWriteLine(var MemoDetails:MemoCfg;LineNum:longint; Status:gStatus);
{}
var A: byte;
Str: string;
begin
if LineNum < 1 then exit;
with MemoDetails do
begin
if Status in [Activate,HiStatus] then
A := Col[MemoHi]
else
A := Col[MemoNorm];
if LineNum = pred(TopNode) + CursorPosY then
Str := LineStr
else
Str := GetLine(@MemoDetails,LineNum);
Str := padleft(copy(Str,FirstCharPos,255),succ(X2-X1) - ord(DrawVScroll),' ');
if BlockActive(MemoDetails) and (BlockY1 <= LineNum) and (BlockY2 >= LineNum) then {this line is part of block}
MemoWriteLineInBlock(MemoDetails,Str,LineNum)
else
WriteAT(X1,Y1+LineNum-TopNode,A,Str);
end;
end; { MemoWriteLine }
procedure MemoRefreshHeadFoot(var MemoDetails: MemoCfg);
{}
var
Counter,
I: integer;
TempStr: string;
W,X: byte;
begin
with Memodetails do
begin
Counter := 0;
if Scrollheader then
X := FirstCharPos
else
X := 1;
W := (X2-X1)-ord(TotalNodes > succ(Y2-Y1));
for I := 1 to ListMaxHeaders do
begin
if Memodetails.Headers[I] <> nil then
begin
inc(Counter);
TempStr := copy(Memodetails.Headers[I]^,X,W);
if (TempStr <> '') and (TempStr[1] = '^') then
begin
delete(TempStr,1,1);
WriteBetween(succ(leftGap),X2-X1-RightGap,TopGap+Counter,Col[MemoHeaders],TempStr);
end
else
WriteAT(succ(leftGap),TopGap+Counter,Col[MemoHeaders],TempStr);
end;
end;
Counter := 0;
if ScrollFooter then
X := FirstCharPos
else
X := 1;
for I := 1 to ListMaxFooters do
begin
if Memodetails.Footers[I] <> nil then
begin
inc(Counter);
TempStr := copy(Memodetails.Footers[I]^,X,W);
if (TempStr <> '') and (TempStr[1] = '^') then
begin
delete(TempStr,1,1);
WriteBetween(succ(leftGap),X2-X1-RightGap,Y2+Counter,Col[MemoHeaders],TempStr);
end
else
WriteAT(succ(leftGap),Y2+Counter,Col[MemoHeaders],TempStr);
end;
end;
end;
end; {MemoRefreshHeadFoot}
procedure DisplayMemo(var MemoDetails:MemoCfg; Status:gStatus);
{}
var I: integer;
begin
MemoRefreshHeadFoot(Memodetails);
with MemoDetails do
begin
if LineStr = NilLine then
begin
TopNode := 1;
CursorPosY := 1;
case DataType of
SourceStrLL: TotalNodes := StringLL(DataSource^).TotalNodes;
SourceSLL: TotalNodes := SingleLL(DataSource^).TotalNodes;
SourceDLL: TotalNodes := DoubleLL(DataSource^).TotalNodes;
end; {case}
LineStr := GetLine(@Memodetails,1);
end;
for I := TopNode to TopNode + Y2 - Y1 do
MemoWriteLine(MemoDetails,I,Status);
{update scroll bars}
MemoWriteVScrollBar(MemoDetails,Status);
end;
end; { DisplayMemo }
{$IFDEF CUTANDPASTE}
procedure TurnBlockOff(var MemoDetails:MemoCfg);
{}
var WasActive: boolean;
begin
WasActive := BlockActive(Memodetails);
with MemoDetails do
begin
BlockX2 := BlockX1;
BlockY2 := BlockY1;
end;
if WasActive then
DisplayMemo(MemoDetails,HiStatus);
end; { TurnBlockOff }
{$ELSE}
procedure TurnBlockOff(var MemoDetails:MemoCfg);
begin end;
{$ENDIF}
{*************************}
{** Cursor Management **}
{*************************}
procedure MoveCursor(var MemoDetails: MemoCfg);
{}
var X,Y: byte;
begin
with MemoDetails do
begin
X := CursorPosX + LeftGap;
Y := CursorPosY + TopGap + YH;
if InWindow then
gotoXY(X,Y)
else
gotoXY(pred(X1+X+pred(FirstCharPos)),pred(Y1+Y));
if DrawVScroll then
MemoWriteVScrollBar(MemoDetails, HiStatus);
end;
end; { MoveCursor }
procedure CursorEnd(var MemoDetails: MemoCfg);
{}
var OldStart, NewPos: integer;
begin
with MemoDetails do
begin
OldStart := FirstCharPos;
NewPos := length(LineStr) + ord(not Wordwrap);
if NewPos > MaxWidth then
NewPos := MaxWidth;
if NewPos < FirstCharPos then
FirstCharPos := 1
else if NewPos - pred(FirstCharPos) > (X2-X1) then
FirstCharPos := NewPos - (X2-X1) {+ ord(NewPos = MaxWidth)} + 1;
CursorPosX := NewPos - pred(FirstCharPos);
if pred(FirstCharPos) + CursorPosX > MaxWidth then
dec(CursorPosX);
if OldStart <> FirstCharPos then
DisplayMemo(Memodetails,HiStatus);
end;
MoveCursor(Memodetails);
end; { CursorEnd }
procedure CursorHome(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
CursorPosX := 1;
if FirstCharPos > 1 then
begin
FirstCharPos := 1;
DisplayMemo(Memodetails,HiStatus);
end;
MoveCursor(Memodetails);
end;
end; { CursorHome }
procedure CheckXandMove(var MemoDetails: MemoCfg);
{}
var RealPos: integer;
begin
with MemoDetails do
if pred(FirstCharPos)+CursorPosX > length(LineStr) then
CursorEnd(MemoDetails)
else if CursorPosX >= (X2-X1) then
begin
RealPos := pred(FirstCharPos)+CursorPosX;
CursorPosX := (X2-X1);
FirstCharPos := RealPos - pred(CursorPosX);
DisplayMemo(Memodetails,HiStatus);
MoveCursor(MemoDetails);
end else
MoveCursor(MemoDetails);
end; { CheckXandMove }
procedure CursorUp(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if (CursorPosY = 1) and (TopNode = 1) then
exit;
if TargetPosX = 0 then
TargetPosX := pred(FirstCharPos) + CursorPosX;
CursorPosX := TargetPosX - pred(FirstCharPos);
if CursorPosY = 1 then
begin
if TopNode > 1 then
begin
SetLine(@MemoDetails,TopNode,LineStr);
dec(TopNode);
LineStr := GetLine(@MemoDetails,TopNode);
DisplayMemo(MemoDetails,HiStatus);
CheckXandMove(Memodetails);
end;
end else
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
dec(CursorPosY);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
CheckXandMove(Memodetails);
end;
end;
end; { CursorUp }
procedure CursorDown(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if TargetPosX = 0 then
TargetPosX := pred(FirstCharPos) + CursorPosX;
CursorPosX := TargetPosX - pred(FirstCharPos);
if pred(TopNode) + CursorPosY < TotalNodes then
begin
if CursorPosY < succ(Y2-Y1) then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
inc(CursorPosY);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
end else
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
inc(TopNode);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
DisplayMemo(MemoDetails,HiStatus);
end;
CheckXandMove(Memodetails);
end;
end;
end; { CursorDown }
procedure CursorLeft(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
if pred(FirstCharPos) + CursorPosX > 1 then
begin
if CursorPosX > 1 then
begin
dec(CursorPosX);
MoveCursor(MemoDetails);
end else
begin
dec(FirstCharPos);
DisplayMemo(MemoDetails,HiStatus);
end;
end else
if WordWrap and ((TopNode > 1) or (CursorPosY > 1)) then
begin
CursorUp(MemoDetails);
CursorEnd(MemoDetails);
end;
end; { CursorLeft }
procedure CursorRight(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
if pred(FirstCharPos) + CursorPosX < length(LineStr) + ord(not WordWrap) then
begin
if pred(FirstCharPos) + CursorPosX < MaxWidth then
begin
if CursorPosX >= (X2-X1) then
begin
inc(FirstCharPos);
DisplayMemo(MemoDetails,HiStatus);
end else
inc(CursorPosX);
MoveCursor(MemoDetails);
end;
end else
if WordWrap then
begin
if pred(TopNode) + CursorPosY < TotalNodes then
begin
CursorDown(MemoDetails);
CursorHome(MemoDetails);
end;
end;
end; { CursorRight }
procedure CursorRightWord(var MemoDetails: MemoCfg);
{}
var OldX: byte;
OldY: longint;
SpacePassed: boolean;
begin
with MemoDetails do
begin
SpacePassed := false;
repeat
if LineStr[pred(FirstCharPos)+CursorPosX] in [' ',MemoVars.EndofParaCode] then
SpacePassed := true;
OldX := pred(FirstCharPos)+CursorPosX;
OldY := pred(TopNode) + CursorPosY;
CursorRight(Memodetails);
until ((OldX = pred(FirstCharPos)+CursorPosX) and (OldY = pred(TopNode) + CursorPosY))
or (not(LineStr[pred(FirstCharPos)+CursorPosX] in [' ',MemoVars.EndofParaCode]) and SpacePassed);
MoveCursor(MemoDetails);
end;
end; { CursorRightWord }
procedure CursorLeftWord(var MemoDetails: MemoCfg);
{}
var OldX: byte;
OldY: longint;
CharacterPassed: boolean;
begin
with MemoDetails do
begin
CharacterPassed := false;
CursorLeft(MemoDetails);
repeat
if not (LineStr[pred(FirstCharPos)+CursorPosX] in [' ',MemoVars.EndofParaCode]) then
CharacterPassed := true;
OldX := pred(FirstCharPos)+CursorPosX;
OldY := pred(TopNode) + CursorPosY;
CursorLeft(Memodetails);
until ((OldX = pred(FirstCharPos)+CursorPosX) and (OldY = pred(TopNode) + CursorPosY))
or ((LineStr[pred(FirstCharPos)+CursorPosX] in [' ',MemoVars.EndofParaCode]) and CharacterPassed);
if not ((FirstCharPos =1) and (CursorPosX = 1) and (TopNode = 1) and ((CursorPosY = 1) or not WordWrap)) then
CursorRightWord(Memodetails);
MoveCursor(MemoDetails);
end;
end; { CursorLeftWord }
procedure CursorPgUp(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if TopNode > 1 then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
dec(TopNode,succ(Y2-Y1));
if TopNode < 1 then
TopNode := 1;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
DisplayMemo(MemoDetails,HiStatus);
end else
if CursorPosY <> 1 then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
CursorPosY := 1;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
end;
CheckXandMove(Memodetails);
end;
end; { CursorPgUp }
procedure CursorPgDn(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if pred(TopNode + succ(Y2-Y1)) < TotalNodes then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
inc(TopNode,succ(Y2-Y1));
CursorPosY := 1;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
DisplayMemo(MemoDetails,HiStatus);
CheckXandMove(Memodetails);
end else
if CursorPosY + pred(TopNode) < TotalNodes then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
CursorPosY := succ(Y2-Y1);
if CursorPosY + pred(TopNode) > TotalNodes then
CursorPosY := TotalNodes - pred(TopNode);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
CheckXandMove(Memodetails);
end;
end;
end; { CursorPgDn }
procedure CursorTop(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if (CursorPosY <> 1) or (TopNode <> 1) then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
CursorPosY := 1;
TopNode := 1;
LineStr := GetLine(@MemoDetails,1);
if FirstCharPos = 1 then
DisplayMemo(MemoDetails,HiStatus);
end;
CursorHome(MemoDetails);
end;
end; { CursorTop }
procedure CursorBottom(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
if TopNode + (X2 - X1) >= TotalNodes then
CursorPgDn(Memodetails)
else
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
TopNode := TotalNodes - (Y2 - Y1);
CursorPosY := succ(Y2-Y1);
LineStr := GetLine(@MemoDetails,TotalNodes);
if FirstCharPos = 1 then
DisplayMemo(MemoDetails,HiStatus);
end;
CursorHome(MemoDetails);
end;
end; { CursorBottom }
{*************************}
{** Wrapping Routines **}
{*************************}
{$IFDEF WORDWRAP}
function GetNextLinesLeadingSpaces(var MemoDetails: MemoCfg;var S1,S2: string; var LastLine:boolean): byte;
{Removes the spaces from the beginning of line two, and adds them to
the end of line one}
var Counter: byte;
begin
counter := 0;
if S2 = '' then
S2 := MemoVars.EndofParaCode;
while (S2 <> (MemoVars.EndofParaCode))
and (S2[1] = ' ')
and (length(S1) < MemoDetails.MaxWidth) do
begin
S1 := S1+' ';
delete(S2,1,1);
LastLine := false;
inc(Counter);
if S2 = '' then
S2 := MemoVars.EndofParaCode;
end;
GetNextLinesLeadingSpaces := counter;
end; { GetNextLinesLeadingSpaces }
procedure GetNextLinesFullWords(var MemoDetails: MemoCfg;var S1,S2: string;var LastLine:boolean; Line:integer);
var WordSize: byte;
RoomLeft: integer;
Finished: boolean;
BytesMoved: byte;
begin
Finished := false;
BytesMoved := 0;
with Memodetails do
begin
repeat
inc(BytesMoved,GetNextLinesLeadingSpaces(Memodetails,S1,S2,LastLine));
RoomLeft := MaxWidth - length(S1);
if RoomLeft > 0 then
begin
WordSize := pos(' ',S2);
if WordSize = 0 then
WordSize := length(S2);
if (WordSize > 0)
and (WordSize <= RoomLeft) then
begin
S1 := S1 + copy(S2,1,WordSize);
delete(S2,1,WordSize);
inc(BytesMoved,WordSize);
if S2 = '' then {shift up the next line}
begin
DelLine(@MemoDetails,succ(Line));
if succ(Line) <= Totalnodes then
dec(Totalnodes); {RDA}
S2 := GetLine(@MemoDetails,succ(Line));
end;
if (S2 = '') and (Line < TotalNodes) then
S2 := MemoVars.EndofParaCode;
if S1[Length(S1)] = MemoVars.EndofParaCode then
begin
LastLine := true;
Finished := true;
end else
LastLine := false;
end else
Finished := true;
end else
Finished := true;
until Finished;
if (BytesMoved > 0) and (succ(Line) = pred(TopNode) + CursorPosY) then {move cursor}
begin
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
if CursorPosX > BytesMoved then
dec(CursorPosX,BytesMoved)
else
begin
CursorUp(Memodetails);
CursorPosX := length(S1) {- pred(BytesMoved)};
end;
MoveCursor(Memodetails);
end;
end;
end; { GetNextLinesFullWords }
procedure PushWordsToNextLine(var MemoDetails: MemoCfg;var S1,S2: string;var LastLine: boolean;
Line:integer; AddSpaces:boolean; var BytesMoved:byte);
{}
var L: byte;
Counter: integer;
begin
with MemoDetails do
begin
Counter := pos(MemoVars.EndofParaCode,S1);
L := length(S1);
if (L > 0) and (Counter = L) and (Counter <= MaxWidth) and not AddSpaces then
LastLine := true
else
begin
if (Counter = 0) or (Counter > MaxWidth) then {no paragraph split}
begin
Counter := length(S1);
repeat
dec(Counter);
until (Counter = 0) or ((S1[Counter] = ' ') and (Counter <= MaxWidth));
end;
if (Counter = 0) and (length(S1) > MaxWidth) then {no spaces so split word}
Counter := MaxWidth;
if ((S2 = MemoVars.EndofParaCode)
and
(Counter < Length(S1))
)
or
( length(S2) + length(S1)-Counter > pred(sizeof(S2))) then {insert a new line}
begin
TotalNodes := InsLine(@MemoDetails,succ(Line));
S2 := '';
end;
if AddSpaces
and (S1[Length(S1)] <> ' ')
and (S1[Length(S1)] <> MemoVars.EndofParaCode)
and (S2 <> MemoVars.EndofParaCode)
and (S2 <> '') then
insert(' ',S2,1);
insert(copy(S1,succ(Counter),length(S1)-Counter),S2,1);
BytesMoved := length(S1)-Counter;
delete(S1,succ(Counter),length(S1)-Counter);
if length(S2) > MaxWidth then
Lastline := false;
end;
end;
end; { PushWordsToNextLine }
procedure WrapFrom(var MemoDetails: MemoCfg;Line:longint;Paragraphs:word);
{}
var S1,S2: string;
ParasWrapped : word;
LastLine: boolean;
I: integer;
BytesMovedDown: byte;
LastLineLen: byte;
function GetString(TheLine:longint): string;
{}
begin
with MemoDetails do
if TheLine = pred(TopNode) + CursorPosY then {active line}
GetString := LineStr
else
begin
if (TheLine > MaxLines) and (MaxLines <> 0) then
begin
ParasWrapped := Paragraphs; {time to quit}
GetString := '';
end
else if TheLine > TotalNodes then {insert a line}
begin
TotalNodes := InsLine(@MemoDetails,TheLine);
GetString := '';
end
else {just get the line}
GetString := GetLine(@MemoDetails,TheLine);
end;
end; { GetString }
procedure CheckLastLine;
{}
begin
if LastLine then
begin
LastLine := false;
inc(ParasWrapped);
if Line = Memodetails.TotalNodes then
ParasWrapped := Paragraphs;
end;
end; { CheckLastLine }
begin
if Memodetails.WordWrap then with MemoDetails do
begin
LastLineLen := length(GetLine(@MemoDetails,MaxLines)); {get very last line}
if Line < 1 then
Line := 1;
if (Line >= MaxLines) and (MaxLines <> 0) then {nowhere to wrap!}
begin
if Line = pred(TopNode) + CursorPosY then
begin
if length(LineStr) > MaxWidth then
LineStr := copy(LineStr,1,MaxWidth);
SetLine(@MemoDetails,CursorPosY,LineStr);
MemoWriteLine(MemoDetails,pred(TopNode) + CursorPosY,HiStatus);
end;
end else if not ((TotalNodes = 1) and (length(GetString(1)) <= MaxWidth)) then
begin
S1 := GetString(Line);
S2 := GetString(succ(Line));
ParasWrapped := 0;
repeat
LastLine := true;
if (length(S1) > MaxWidth)
or (pos(MemoVars.EndofParaCode,S1) > 0) then {line must be truncated}
begin
PushWordsToNextLine(MemoDetails,S1,S2,LastLine,Line,true,BytesMovedDown);
SetLine(@MemoDetails,Line,S1);
CheckLastLine;
if ParasWrapped < Paragraphs then
begin
inc(Line);
S1 := S2;
S2 := GetString(succ(Line));
end
else if S2 <> '' then
begin
if Line = TotalNodes then
TotalNodes := InsLine(@MemoDetails,succ(Line));
SetLine(@MemoDetails,succ(Line),S2);
end;
end
else {line might be expanded}
begin
if S2 = '' then
begin
Lastline := true;
ParasWrapped := Paragraphs;
SetLine(@MemoDetails,Line,S1);
end else
begin
LastLine := false;
if S1 <> '' then
GetNextLinesFullWords(Memodetails,S1,S2,LastLine,Line);
SetLine(@MemoDetails,Line,S1);
CheckLastLine;
if ParasWrapped < Paragraphs then
begin
inc(Line);
S1 := S2;
S2 := GetLine(@MemoDetails,succ(Line));
end
else if succ(Line) <= TotalNodes then
SetLine(@MemoDetails,succ(Line),S2);
end;
end;
until ParasWrapped = Paragraphs;
if (Line >= pred(TotalNodes)) {strip a trailing empty line}
and (S2 = '') then
begin
S2 := GetLine(@MemoDetails,TotalNodes);
if S2 = '' then
begin
DelLine(@MemoDetails,TotalNodes);
dec(TotalNodes);
end;
end;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
if (CursorPosY > 1) and (Line >= TopNode) then
MemoWriteLine(Memodetails,pred(TopNode)+pred(CursorPosY),HiStatus);
for I := CursorPosY to succ(Y2-Y1) do
MemoWriteLine(Memodetails,pred(TopNode)+I,HiStatus)
end;
{check to see if text may be pushed off the end}
if (MaxLines <> 0)
and (TotalNodes = MaxLines)
and (pred(TopNode)+CursorPosY <> MaxLines)
and (LastLineLen < length(GetLine(@MemoDetails,MaxLines)))
and not WarningGiven then
begin
MemoWarning(6);
WarningGiven := true;
end;
if TotalNodes < MaxLines then
WarningGiven := false;
end;
end; { WrapFrom }
procedure WrapFullEngine(var MemoDetails: MemoCfg;AddSpaces:boolean);
{Call this method to word wrap text before displaying it. This saves
you the chore of inititally wordwrapping the default text.}
var S1,S2: string;
LastLine: boolean;
Line : integer;
P,BytesMovedDown: byte;
begin
if Memodetails.WordWrap then with MemoDetails do
begin
Line := 1;
LastLine := false;
S1 := GetLine(@MemoDetails,1);
S2 := GetLine(@MemoDetails,2);
(*
repeat
P := pos(MemoVars.EndofParaCode,S1);
if (length(S1) > MaxWidth) or ( (P > 0) and (P < length(S1))) then
PushWordsToNextLine(MemoDetails,S1,S2,LastLine,Line,AddSpaces,BytesMovedDown)
else
if (S1 <> '') and (S1[length(S1)] <> MemoVars.EndofParaCode) then
GetNextLinesFullWords(MemoDetails,S1,S2,LastLine,Line);
SetLine(@MemoDetails,Line,S1);
inc(Line);
if (MaxLines = 0) or (Line <= MaxLines) then
begin
S1 := S2;
if (succ(Line) > TotalNodes)
and (length(S1) > MaxWidth) then
begin
S2 := '';
TotalNodes := InsLine(@MemoDetails,succ(TotalNodes));
end else
S2 := GetLine(@MemoDetails,succ(Line));
end;
until ((MaxLines <> 0) and (Line > MaxLines))
or ((length(S1) <= MaxWidth) and (Line > TotalNodes));
*)
P := pos(MemoVars.EndofParaCode,S1);
repeat
if (length(S1) > MaxWidth) or ( (P > 0) and (P < length(S1))) then
PushWordsToNextLine(MemoDetails,S1,S2,LastLine,Line,AddSpaces,BytesMovedDown)
else
if (S1 <> '') and (S1[length(S1)] <> MemoVars.EndofParaCode) then
GetNextLinesFullWords(MemoDetails,S1,S2,LastLine,Line);
SetLine(@MemoDetails,Line,S1);
inc(Line);
if (MaxLines = 0) or (Line <= MaxLines) then
begin
S1 := S2;
if (succ(Line) > TotalNodes)
and (length(S1) > MaxWidth) then
begin
S2 := '';
TotalNodes := InsLine(@MemoDetails,succ(TotalNodes));
end else
S2 := GetLine(@MemoDetails,succ(Line));
end;
P := pos(MemoVars.EndofParaCode,S1);
case DataType of
SourceSLL: TotalNodes := SingleLL(MemoDetails.DataSource^).TotalNodes;
SourceDLL: TotalNodes := DoubleLL(MemoDetails.DataSource^).TotalNodes;
end;
until ((MaxLines <> 0) and (Line > MaxLines))
or ( (length(S1) <= MaxWidth)
and (Line > TotalNodes)
and ((P = 0) or (P = length(S1)))
);
SetLine(@MemoDetails,Line,copy(S1,1,MaxWidth));
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
{finally strip all empty lines from the bottom}
case DataType of
SourceSLL: TotalNodes := SingleLL(MemoDetails.DataSource^).TotalNodes;
SourceDLL: TotalNodes := DoubleLL(MemoDetails.DataSource^).TotalNodes;
end;
if DataType <> SourceArray then
begin
repeat
if DataType = SourceSLL then
Line := SingleLL(MemoDetails.DataSource^).TotalNodes
else if DataType = SourceDLL then
Line := DoubleLL(MemoDetails.DataSource^).TotalNodes;
S1 := GetLine(@MemoDetails,Line);
if S1 = '' then
begin
DelLine(@MemoDetails,Line);
dec(TotalNodes);
end;
until (TotalNodes <= 1) or (S1 <> '');
{!!make sure last line includes a MemoVars.EndofParaCode}
end;
end;
end; { WrapFullEngine }
procedure WrapFull(var MemoDetails: MemoCfg);
{}
begin
WrapFullEngine(memodetails,true);
end; {WrapFull}
procedure WrapFullNoSpaces(var MemoDetails: MemoCfg);
{}
begin
WrapFullEngine(memodetails,false);
end; {WrapFullNoSpaces}
{$ENDIF}
procedure RemoveTrailingLines(var MemoDetails: MemoCfg);
{}
var TempStr: string;
function EmptyLine: boolean;
{}
begin
EmptyLine := ((TempStr = MemoVars.EndofParaCode)
or
(TempStr = '')
);
end; { EmptyLine }
begin
with MemoDetails do
begin
repeat
TempStr := GetLine(@MemoDetails,TotalNodes);
if EmptyLine then
begin
DelLine(@MemoDetails,TotalNodes);
dec(TotalNodes);
end;
until (TotalNodes <= 1) or not EmptyLine;
end;
end; { RemoveTrailingLines }
{**********************}
{** Key Management **}
{**********************}
{$IFDEF WORDWRAP}
procedure WrapDeleteChar(var MemoDetails: MemoCfg);
{}
var
I : integer;
S1,S2: string;
Dummy,
WasASpace: boolean;
BytesMoved: byte;
begin
with MemoDetails do
begin
if not ( ( ((LineStr = '') or (LineStr = MemoVars.EndofParaCode))
and (CursorPosY = 1)
and (TopNode = 1)
and (TotalNodes = 1)
)
or
( (pred(TopNode)+CursorPosY = TotalNodes)
and (pred(FirstCharPos+CursorPosX) = length(LineStr))
)
) then
begin
Memodetails.IsDirty := true;
TurnBlockOff(memodetails);
if LineStr = MemoVars.EndofParaCode then
begin
DelLine(@MemoDetails,pred(TopNode)+CursorPosY);
dec(TotalNodes);
if pred(TopNode)+CursorPosY > TotalNodes then
CursorLeft(Memodetails);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
for I := pred(TopNode) + CursorPosY to TopNode + Y2 - Y1 do
MemoWriteLine(MemoDetails,I,HiStatus);
end else
begin
{check to see if deleting space at end of line}
WasASpace := (CursorPosX = length(LineStr)) and (LineStr[length(LineStr)] = ' ');
delete(LineStr,pred(FirstCharPos) + CursorPosX,1);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
if WasASpace then {need to join last word with next line}
begin
I := pred(TopNode) + CursorPosY;
S1 := GetLine(@MemoDetails,I);
S2 := GetLine(@MemoDetails,Succ(I));
PushWordsToNextLine(MemoDetails,S1,S2,Dummy,I,false,BytesMoved);
if S1 = '' then {delete the line}
begin
DelLine(@MemoDetails,I);
dec(TotalNodes);
SetLine(@MemoDetails,I,S2);
end else
begin
SetLine(@MemoDetails,I,S1);
SetLine(@MemoDetails,succ(I),S2);
inc(CursorPosY);
end;
CursorHome(Memodetails);
CursorPosX := succ(BytesMoved);
MoveCursor(Memodetails);
LineStr := S2;
WrapFrom(MemoDetails,I,2);
end else
WrapFrom(MemoDetails,pred(TopNode) + pred(CursorPosY),2);
end;
end;
end;
end; { WrapDeleteChar }
procedure WrapProcessEnter(var MemoDetails: MemoCfg);
{splits the line at the cursor, and inserts an end of paragraph marker}
var
PrevLine,CarryOver: string;
begin
with MemoDetails do
begin
if (MaxLines = 0) or (TotalNodes < MaxLines) then {not last line}
begin
Memodetails.IsDirty := true;
TurnBlockOff(memodetails);
CarryOver := copy(LineStr,pred(FirstCharPos)+CursorPosX,length(LineStr)-pred(CursorPosX));
delete(LineStr,CursorPosX,255);
LineStr := LineStr + MemoVars.EndofParaCode;
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
TotalNodes := InsLine(@MemoDetails,TopNode+CursorPosY);
SetLine(@MemoDetails,TopNode+CursorPosY,CarryOver);
if FirstCharPos = 1 then
MemoWriteLine(MemoDetails,TopNode+CursorPosY-2,HiStatus);
LineStr := CarryOver;
PrevLine := GetLine(@MemoDetails,topNode+CursorPosY-2);
inc(CursorPosY);
if PrevLine[length(PrevLine)] = MemoVars.EndofParaCode then
WrapFrom(MemoDetails,pred(TopNode + CursorPosY)-2,3)
else
WrapFrom(MemoDetails,pred(TopNode + CursorPosY)-2,2);
CursorUp(MemoDetails);
CursorRight(MemoDetails);
CursorPosX := 1;
MoveCursor(MemoDetails);
if FirstCharPos = 1 then
MemoWriteLine(MemoDetails,TopNode+CursorPosY-2,HiStatus)
else
begin
FirstCharPos := 1;
DisplayMemo(MemoDetails,HiStatus);
end;
end else {no room to insert}
MemoWarning(5);
end;
end; { WrapProcessEnter }
procedure WrapInsertChar(var MemoDetails: MemoCfg;Ch:char);
{}
var NewX: byte;
begin
with MemoDetails do
begin
Memodetails.IsDirty := true;
TurnBlockOff(memodetails);
insert(Ch,LineStr,pred(FirstCharPos)+CursorPosX);
if (Ch = ' ')
and (pos(' ',LineStr) = CursorPosX)
and (CursorPosY <> 1) then {just entered first space on line}
begin
CursorRight(Memodetails);
Wrapfrom(MemoDetails,pred(TopNode)+pred(CursorPosY),1);
end else
if length(LineStr) > MaxWidth then
begin
WrapFrom(MemoDetails,pred(TopNode)+CursorPosY,1);
if CursorPosX > length(LineStr) then
begin
NewX := CursorPosX - pred(length(LineStr));
CursorHome(MemoDetails);
CursorDown(MemoDetails);
CursorPosX := NewX;
MoveCursor(MemoDetails);
end else
CursorRight(MemoDetails);
end else {just re-display the active line with the new char inserted}
begin
MemoWriteLineStr(MemoDetails);
CursorRight(MemoDetails);
end;
end;
end; { WrapInsertChar }
procedure WrapOvertypeChar(var MemoDetails: MemoCfg;Ch:char);
{}
var NewX: byte;
begin
with MemoDetails do
begin
Memodetails.IsDirty := true;
TurnBlockOff(memodetails);
if LineStr = '' then
LineStr := Ch
else if (CursorPosX <= length(LineStr)) then
LineStr[pred(FirstCharPos) + CursorPosX] := Ch
else
LineStr := LineStr + Ch;
if ((Ch = ' ')
and (pos(' ',LineStr) = CursorPosX)
and (CursorPosY <> 1))
or (pred(FirstCharPos) + CursorPosX > MaxWidth) then {just entered first space on line}
begin
CursorRight(Memodetails);
Wrapfrom(MemoDetails,pred(TopNode)+pred(CursorPosY),1);
if CursorPosX > length(LineStr) then
begin
NewX := CursorPosX - pred(length(LineStr));
CursorHome(MemoDetails);
CursorDown(MemoDetails);
CursorPosX := NewX;
MoveCursor(MemoDetails);
end;
end else
begin
MemoWriteLineStr(MemoDetails);
CursorRight(MemoDetails);
end;
end;
end; { WrapOvertypeChar }
{$ENDIF}
procedure DeleteChar(var MemoDetails: MemoCfg);
{}
var
I: integer;
TempStr:string;
begin
with MemoDetails do
begin
Memodetails.IsDirty := true;
if LineStr = '' then {delete the line}
begin
DelLine(@MemoDetails,pred(TopNode)+CursorPosY);
dec(TotalNodes);
if pred(TopNode)+CursorPosY > TotalNodes then
CursorLeft(Memodetails);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
for I := CursorPosY to Y2-Y1 do
MemoWriteLine(MemoDetails,I,HiStatus);
end else if pred(FirstCharPos) + CursorPosX <= length(LineStr) then
begin
delete(LineStr,pred(FirstCharPos) + CursorPosX,1);
MemoWriteLineStr(MemoDetails);
end else if pred(TopNode)+CursorPosY < TotalNodes then
begin
TempStr := GetLine(@MemoDetails,TopNode+CursorPosY);
if length(TempStr) + length(LineStr) <= MaxWidth then
begin
LineStr := LineStr+TempStr;
DelLine(@MemoDetails,TopNode+CursorPosY); {lineafter cursor}
dec(TotalNodes);
DisplayMemo(MemoDetails,HiStatus);
end;
end;
end; {with}
end; { DeleteChar }
procedure InsertChar(var MemoDetails: MemoCfg;Ch:char);
{}
begin
with MemoDetails do
begin
TurnBlockOff(memodetails);
if length(LineStr) < MaxWidth then
begin
Memodetails.IsDirty := true;
insert(Ch,LineStr,pred(FirstCharPos)+CursorPosX);
CursorRight(MemoDetails);
MemoWriteLineStr(MemoDetails);
end else
begin
Thunk;
PromptOK('',MemoVars.LineFullMsg);
end;
end;
end; { InsertChar }
procedure OvertypeChar(var MemoDetails: MemoCfg;Ch:char);
{}
begin
with MemoDetails do
begin
TurnBlockOff(memodetails);
Memodetails.IsDirty := true;
if LineStr = '' then
LineStr := Ch
else if (pred(FirstCharPos) + CursorPosX <= length(LineStr)) then
LineStr[pred(FirstCharPos) + CursorPosX] := Ch
else
LineStr := LineStr + Ch;
MemoWriteLineStr(MemoDetails);
CursorRight(MemoDetails);
end; {with}
end; { OvertypeChar }
procedure ProcessEnter(var MemoDetails: MemoCfg);
{}
var CarryOver: string;
begin
if MemoDetails.WordWrap then
begin
{$IFDEF WORDWRAP}
WrapProcessEnter(MemoDetails);
{$ENDIF}
end else
with MemoDetails do {split the line and be done with it!}
begin
if (MaxLines = 0) or (TotalNodes < MaxLines) then {not last line}
begin
Memodetails.IsDirty := true;
TurnBlockOff(memodetails);
CarryOver := copy(LineStr,pred(FirstCharPos)+CursorPosX,255);
delete(LineStr,pred(FirstCharPos)+CursorPosX,255);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
TotalNodes := InsLine(@MemoDetails,TopNode+CursorPosY);
SetLine(@MemoDetails,TopNode+CursorPosY,CarryOver);
CursorDown(MemoDetails);
LineStr := CarryOver;
CursorHome(MemoDetails);
DisplayMemo(MemoDetails,HiStatus);
end
else {no room to insert}
MemoWarning(5);
end;
end; {ProcessEnter}
procedure BackSpace(var MemoDetails: MemoCfg);
{}
var TempStr: string;
begin
with MemoDetails do
begin
Memodetails.IsDirty := true;
if (CursorPosX = 1) and (FirstCharPos = 1) and not Wordwrap then
begin
if not ((TopNode = 1) and (CursorPosY = 1)) then {join line with line above}
begin
TempStr := LineStr;
CursorUp(Memodetails);
CursorEnd(Memodetails);
if length(TempStr) + length(LineStr) <= MaxWidth then
begin
LineStr := LineStr+TempStr;
DelLine(@MemoDetails,TopNode+CursorPosY); {lineafter cursor}
dec(TotalNodes);
DisplayMemo(MemoDetails,HiStatus);
end;
end;
exit;
end;
if not ( (CursorPosX = 1)
and (FirstCharPos = 1)
and (CursorPosY = 1)
and (TopNode = 1)
) then
begin
CursorLeft(Memodetails);
{$IFDEF WORDWRAP}
if Wordwrap then
WrapDeleteChar(Memodetails)
else
{$ENDIF}
DeleteChar(Memodetails);
end;
end;
end; { BackSpace }
procedure ProcessChar(var MemoDetails: MemoCfg;Ch:char);
{}
var NewX: byte;
Finished : boolean;
begin
with MemoDetails do
begin
if WordWrap then
begin
{$IFDEF WORDWRAP}
if not ((CursorPosX > MaxWidth) and (CursorPosY + pred(TopNode) = MaxLines)) then
begin
if InsertOn then
WrapInsertChar(MemoDetails,Ch)
else {overtype mode}
WrapOverTypeChar(MemoDetails,Ch);
end;
{$ENDIF}
end else {not in word wrap mode}
begin
if InsertOn then
InsertChar(MemoDetails,Ch)
else {overtype mode}
OverTypeChar(MemoDetails,Ch);
end;
end;
end; { ProcessChar }
procedure MemoAssignHeader(var MemoDetails: MemoCfg; Line:byte; var Heading:string);
{}
begin
if (Line < 1) or (Line > ListMaxHeaders) then
MemoSetError(1003)
else
Memodetails.Headers[Line] := @Heading;
end; {MemoAssignHeader}
procedure MemoAssignFooter(var MemoDetails: MemoCfg; Line:byte; var Footnote:string);
{}
begin
if (Line < 1) or (Line > ListMaxFooters) then
MemoSetError(1003)
else
Memodetails.Footers[Line] := @Footnote;
end; {MemoAssignFooter}
procedure MemoRemoveHeader(var MemoDetails: MemoCfg; Line:byte);
{}
begin
if (Line < 1) or (Line > ListMaxHeaders) then
MemoSetError(1003)
else
Memodetails.Headers[Line] := nil;
end; {MemoRemoveHeader}
procedure MemoRemoveFooter(var MemoDetails: MemoCfg; Line:byte);
{}
begin
if (Line < 1) or (Line > ListMaxFooters) then
MemoSetError(1003)
else
Memodetails.Footers[Line] := nil;
end; {MemoRemoveFooter}
procedure MemoScrollHeader(var MemoDetails: MemoCfg; On:boolean);
{}
begin
MemoDetails.ScrollHeader := On;
end; {MemoScrollHeader}
procedure MemoScrollFooter(var MemoDetails: MemoCfg; On:boolean);
{}
begin
MemoDetails.ScrollFooter := On;
end; {MemoScrollFooter}
procedure SetInnerDimensions(var MemoDetails: MemoCfg);
{Asseses the window dimensions and sets the list coordinates
X1..Y2 based on the window style and the gapxxx settings}
var
Counter,
I: integer;
begin
with MemoDetails do
begin
X1 := 1 + LeftGap;
Y1 := 1 + TopGap;
X2 := WX2-succ(WX1)-2*ord(WStyle in [7,8]) - RightGap;
Y2 := WY2-succ(WY1) - BotGap;
{now adjust for the headers and footers}
Counter := 0;
for I := 1 to ListMaxHeaders do
inc(Counter,ord(Memodetails.Headers[I] <> nil));
YH := Counter;
inc(Y1,Counter);
Counter := 0;
for I := 1 to ListMaxFooters do
inc(Counter,ord(Memodetails.Footers[I] <> nil));
dec(Y2,Counter);
if Y2 <= Y1 then
Y2 := Y1;
end;
end; { SetInnerDimensions }
{************************}
{** Block Management **}
{************************}
{$IFDEF CUTANDPASTE}
procedure EraseBlock(var MemoDetails: MemoCfg);
{}
var I, WholeLineCount: integer;
begin
if BlockActive(MemoDetails) then with MemoDetails do
begin
Memodetails.IsDirty := true;
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr); {save edits on cursor line}
WholeLineCount := pred(BlockY2 - BlockY1) + ord(BlockX1 = 1);
for I := 1 to WholelineCount do
DelLine(@MemoDetails,BlockY1+ord(BlockX1 <> 1));
{now delete the partial lines}
if BlockY1 = BlockY2 then
begin
LineStr := GetLine(@MemoDetails,BlockY1);
delete(LineStr,BlockX1,BlockX2 - BlockX1);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
end else
begin
if BlockX1 <> 1 then
begin
LineStr := GetLine(@MemoDetails,BlockY1);
delete(LineStr,BlockX1,255);
SetLine(@MemoDetails,BlockY1,LineStr);
end;
if BlockX2 <> 1 then
begin
LineStr := GetLine(@MemoDetails,BlockY2-WholeLineCount);
delete(LineStr,1,pred(BlockX2));
SetLine(@MemoDetails,BlockY2-WholeLineCount,LineStr);
end;
end;
{move cursor to beginning of block, but make sure that area is
visible in the display area}
if WholeLineCount > 0 then
dec(TotalNodes,WholeLineCount);
if TopNode > BlockY1 then
TopNode := BlockY1;
CursorPosY := BlockY1 - pred(TopNode);
CursorPosX := BlockX1 - pred(FirstCharPos);
TurnBlockOff(Memodetails);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
{$IFDEF WORDWRAP}
if WordWrap then
WrapFrom(MemoDetails,BlockY1-2,2);
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
{$ENDIF}
CheckXandMove(Memodetails);
DisplayMemo(Memodetails,HiStatus);
end else
if MemoVars.DelBlockKey = 339 then
{$IFDEF WORDWRAP}
if Memodetails.WordWrap then
WrapDeleteChar(MemoDetails)
else
{$ENDIF}
DeleteChar(MemoDetails)
end; { EraseBlock }
{***************************}
{** Clipboard Functions **}
{***************************}
procedure ClearClipboardBuffer;
{}
begin
with MemoVars do
begin
if Clipboard <> nil then
begin
_SLLDestroy(ClipBoard^.LineList);
freemem(Clipboard,sizeof(Clipboard^));
ClipBoard := nil;
end;
end;
end; { ClearClipboardBuffer }
function CopyToClipboard(var MemoDetails:MemoCfg): integer;
{}
var RetCode: integer;
TempStr: string;
I: integer;
begin
if BlockActive(MemoDetails) then with MemoDetails do
begin
ClearClipboardBuffer; {empty the buffer first}
if GoldMemAvail < sizeof(MemoVars.Clipboard^) then
begin
MemoWarning(1);
CopyToClipBoard := 1;
end else
with MemoVars do
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr); {save edits on cursor line}
TempStr := GetLine(@MemoDetails,BlockY1);
getmem(ClipBoard,sizeof(Clipboard^));
InitSLLStr(ClipBoard^.LineList);
if BlockY1 = BlockY2 then {one line or less}
begin
RetCode := _SLLAddStr(ClipBoard^.LineList,copy(TempStr,BlockX1,BlockX2 - BlockX1));
ClipBoard^.TotalParagraphs := 0;
end else
begin
TempStr := copy(TempStr,BlockX1,255); {get first line}
RetCode := _SLLAddStr(ClipBoard^.LineList,TempStr);
Clipboard^.TotalParagraphs := ord(pos(MemoVars.EndofParaCode,TempStr) > 0);
Clipboard^.FullLastLine := (BlockX2 = 1);
{we have to mess with the linked lists}
for I := succ(BlockY1) to pred(BlockY2) do
if Retcode = 0 then
begin
TempStr := GetLine(@MemoDetails,I);
RetCode := _SLLAddStr(ClipBoard^.LineList,TempStr);
inc(Clipboard^.TotalParagraphs,ord(pos(MemoVars.EndofParaCode,TempStr) > 0));
end;
if BlockX2 <> 1 then
begin
TempStr := GetLine(@MemoDetails,BlockY2);
RetCode := _SLLAddStr(ClipBoard^.LineList,copy(TempStr,1,pred(BlockX2)));
inc(Clipboard^.TotalParagraphs,ord(pos(MemoVars.EndofParaCode,TempStr) > 0));
end;
end;
CopyToClipBoard := ord(Retcode <> 0);
if Retcode <> 0 then
MemoWarning(2); {only part of block copied to clipboard}
end;
end;
end; { CopyToClipboard }
procedure DelToClipboard(var MemoDetails: MemoCfg);
{}
begin
if CopyToClipboard(Memodetails) = 0 then
EraseBlock(Memodetails);
end; { DelToClipboard }
{$IFDEF WORDWRAP}
procedure WWInsFromClipboard(var MemoDetails: MemoCfg);
{}
var TempStr,CarryOver: string;
TempList: SingleLL;
NP: SingleNodePtr;
StartLeft,StartX,StartY: integer;
I, StartTop: longint;
begin
with MemoDetails do
with MemoVars do
if (Clipboard <> nil) and not UsingArray then
begin
Memodetails.IsDirty := true;
TurnBlockOff(MemoDetails);
{record the starting cursor position}
StartX := CursorPosX;
StartY := CursorPosY;
StartTop := TopNode;
StartLeft := FirstCharPos;
{split the line at the cursor position}
if StartX <> 1 then
begin
CarryOver := copy(LineStr,pred(FirstCharPos)+CursorPosX,255);
delete(LineStr,pred(FirstCharPos)+CursorPosX,255);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
inc(CursorPosY);
TotalNodes := InsLine(@MemoDetails,pred(TopNode)+CursorPosY);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,CarryOver);
end;
{now insert all the lines from the clipboard}
for I := ClipBoard^.LineList.TotalNodes downto 1 do
begin
LineStr := _SLLGetNodeStr(ClipBoard^.LineList,_SLLNodePtr(ClipBoard^.LineList,I),255);
TotalNodes := InsLine(@MemoDetails,pred(TopNode)+CursorPosY);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
end;
{wordwrap the inserted text}
WrapFrom(MemoDetails,pred(TopNode)+CursorPosY - 1,succ(Clipboard^.TotalParagraphs)+3);
{restore cursor details}
CursorPosX := StartX;
CursorPosY := StartY;
TopNode := StartTop;
FirstCharPos := StartLeft;
MoveCursor(Memodetails);
end;
end; { WWInsFromClipboard }
{$ENDIF} {WORDWRAP}
procedure InsFromClipboard(var MemoDetails: MemoCfg);
{}
var TempStr,CarryOver: string;
TempList: SingleLL;
NP: SingleNodePtr;
StartLeft,StartX,StartY: integer;
I, StartTop: longint;
begin
with MemoDetails do
with MemoVars do
if (Clipboard <> nil) and not UsingArray then
begin
Memodetails.IsDirty := true;
TurnBlockOff(MemoDetails);
{record the starting cursor position}
StartX := CursorPosX;
StartY := CursorPosY;
StartTop := TopNode;
StartLeft := FirstCharPos;
{get first line of clipboard}
TempStr := _SLLGetNodeStr(ClipBoard^.LineList,_SLLNodePtr(ClipBoard^.LineList,1),255);
if ClipBoard^.LineList.TotalNodes = 1 then {insert at cursor pos}
begin
if length(TempStr) + length(LineStr) > MaxWidth then
MemoWarning(4)
else
begin
insert(TempStr,LineStr,pred(FirstCharPos)+CursorPosX);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
MemoWriteLineStr(MemoDetails);
end
end else {multiple lines in clipboard}
begin
if pred(StartLeft) + StartX <> 1 then
begin
CarryOver := copy(LineStr,pred(FirstCharPos)+CursorPosX,255);
if length(TempStr) + length(LineStr) - length(CarryOver) > MaxWidth then
begin
MemoWarning(4);
exit;
end else
begin
delete(LineStr,pred(FirstCharPos)+CursorPosX,255);
LineStr := LineStr + TempStr; {add first line of clipboard}
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
if CarryOver <> '' then
begin
inc(CursorPosY);
TotalNodes := InsLine(@MemoDetails,pred(TopNode)+CursorPosY);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,CarryOver);
end;
end;
end else
begin
TotalNodes := InsLine(@MemoDetails,pred(TopNode)+CursorPosY);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,TempStr);
end;
{now insert all the remaining lines from the clipboard}
for I := 2 to ClipBoard^.LineList.TotalNodes do
begin
LineStr := _SLLGetNodeStr(ClipBoard^.LineList,_SLLNodePtr(ClipBoard^.LineList,I),255);
inc(CursorPosY);
TotalNodes := InsLine(@MemoDetails,pred(TopNode)+CursorPosY);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
end;
if (ClipBoard^.FullLastLine = false)
and (pred(TopNode)+CursorPosY < TotalNodes) then {try to combine with next line}
begin
TempStr := GetLine(@MemoDetails,TopNode+CursorPosY);
if (length(LineStr) + Length(TempStr) < MaxWidth) then
begin
LineStr := LineStr+TempStr;
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
DelLine(@MemoDetails,TopNode+CursorPosY);
dec(TotalNodes);
end;
end;
end;
{restore cursor details}
CursorPosX := StartX;
CursorPosY := StartY;
TopNode := StartTop;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
FirstCharPos := StartLeft;
MoveCursor(Memodetails);
DisplayMemo(Memodetails,HiStatus);
end;
end; { InsFromClipboard }
{$ENDIF}
{*********************}
{** Block Marking **}
{*********************}
{$IFDEF CUTANDPASTE}
procedure MarkBlockEnd(var MemoDetails: MemoCfg);
{}
var WasActive: boolean;
begin
with MemoDetails do
begin
WasActive := BlockActive(MemoDetails);
BlockX2 := pred(FirstCharPos) + CursorPosX;
BlockY2 := pred(TopNode) + CursorPosY;
if BlockActive(MemoDetails) then
DisplayMemo(MemoDetails,HiStatus)
else if WasActive then
DisplayMemo(MemoDetails,HiStatus);
end;
end; { MarkBlockEnd }
procedure MarkBlockStart(var MemoDetails: MemoCfg);
{}
var WasActive: boolean;
begin
with MemoDetails do
begin
WasActive := BlockActive(MemoDetails);
BlockX1 := pred(FirstCharPos) + CursorPosX;
BlockY1 := pred(TopNode) + CursorPosY;
if BlockActive(MemoDetails) then
DisplayMemo(MemoDetails,HiStatus)
else if WasActive then
DisplayMemo(MemoDetails,HiStatus);
end;
end; { MarkBlockStart }
procedure SetEndofBlock(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
BlockX2 := pred(FirstCharPos) + CursorPosX;
BlockY2 := pred(TopNode) + CursorPosY;
DisplayMemo(MemoDetails,HiStatus);
end;
end; { SetEndofBlock }
procedure SetStartofBlock(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
BlockX1 := pred(FirstCharPos) + CursorPosX;
BlockY1 := pred(TopNode) + CursorPosY;
DisplayMemo(MemoDetails,HiStatus);
end;
end; { SetStartofBlock }
procedure SetBlockStartEnd(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
AtBlockStart := (BlockX1 = pred(FirstCharPos) + CursorPosX)
and
(BlockY1 = pred(TopNode) + CursorPosY);
AtBlockEnd := (BlockX2 = pred(FirstCharPos) + CursorPosX)
and
(BlockY2 = pred(TopNode) + CursorPosY);
end;
end; { SetBlockStartEnd }
procedure PrepareForMark(var MemoDetails: MemoCfg);
{}
procedure NewBlock;
{}
begin
with memodetails do
begin
AtBlockStart := true;
AtBlockEnd := true;
BlockX1 := pred(FirstCharPos) + CursorPosX;
BlockY1 := pred(TopNode) + CursorPosY;
BlockX2 := pred(FirstCharPos) + CursorPosX;
BlockY2 := pred(TopNode) + CursorPosY;
end;
end; { NewBlock }
begin
with MemoDetails do
begin
if not BlockActive(MemoDetails) then
NewBlock
else
begin
SetBlockStartEnd(MemoDetails);
if not (AtBlockStart or AtBlockEnd) then
NewBlock;
end;
end;
end; { PrepareForMark }
function CursorBeforeStart(var MemoDetails: MemoCfg): boolean;
{}
begin
with MemoDetails do
CursorBeforeStart := (BlockY1 > pred(TopNode) + CursorPosY)
or
( (BlockY1 = pred(TopNode) + CursorPosY)
and
(BlockX1 > pred(FirstCharPos) + CursorPosX)
)
end; { CursorBeforeStart }
function CursorAfterEnd(var MemoDetails: MemoCfg): boolean;
{}
begin
with MemoDetails do
CursorAfterEnd := (BlockY2 < pred(TopNode) + CursorPosY)
or
( (BlockY2 = pred(TopNode) + CursorPosY)
and
(BlockX2 < pred(FirstCharPos) + CursorPosX)
)
end; { CursorAfterEnd }
procedure SetStarttoEnd(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
BlockX2 := BlockX1;
BlockY2 := BlockY1;
end;
end; { SetStarttoEnd }
procedure SetEndtoStart(var MemoDetails: MemoCfg);
{}
begin
with MemoDetails do
begin
BlockX1 := BlockX2;
BlockY1 := BlockY2;
end;
end; { SetEndtoStart}
procedure MarkNewBlock(var MemoDetails: MemoCfg;Backward:boolean);
{}
begin
if Marking then
begin
if Backward then
begin
if AtBlockStart then
SetStartOfBlock(MemoDetails)
else if AtBlockEnd and CursorBeforeStart(MemoDetails) then
begin
SetStarttoEnd(MemoDetails);
SetStartOfBlock(MemoDetails);
end else
SetEndOfBlock(MemoDetails);
end else {forward}
begin
if AtBlockStart and AtBlockEnd then
SetEndOfBlock(MemoDetails)
else if AtBlockStart and CursorAfterEnd(MemoDetails) then
begin
SetEndtoStart(MemoDetails);
SetEndOfBlock(MemoDetails);
end else
if AtBlockStart then
SetStartOfBlock(MemoDetails)
else
SetEndOfBlock(MemoDetails);
end;
end;
end; { MarkNewBlock }
function UpOrDownKey(K:word): boolean;
{}
begin
UpOrDownKey := (K = 336) or (K = 436) or (K = 328) or (K = 428);
end; { UpOrDownKey }
{$ELSE}
procedure MarkNewBlock(var MemoDetails: MemoCfg;Backward:boolean);
begin end;
{$ENDIF}
{************************}
{** Mouse Management **}
{************************}
procedure MemoScrollBar(var MemoDetails: MemoCfg);
{}
var L,M,R: boolean;
X,Y,ElevatorY:byte;
WaitTime: integer;
procedure ScrollUpOne;
{}
begin
with MemoDetails do
repeat
MouseStatusWin(L,M,R,X,Y);
if (X = X2) and (Y = Y1) and L then
CursorUp(MemoDetails);
DelayIt(L,WindowHasFocus,WaitTime);
until not L;
end; { ScrollUpOne }
procedure ScrollDownOne;
{}
begin
with MemoDetails do
repeat
MouseStatusWin(L,M,R,X,Y);
if (X = X2) and (Y = Y2) and L then
CursorDown(MemoDetails);
DelayIt(L,WindowHasFocus,WaitTime);
until not L;
end; { ScrollDownOne }
procedure ScrollUpward;
{}
begin
with MemoDetails do
repeat
MouseStatusWin(L,M,R,X,Y);
if not ((TopNode = 1) and (CursorPosY = 1)) then
begin
if (X = X2) and (Y >= Y1) and (Y <= ElevatorY) and L then
CursorPgUp(MemoDetails);
DelayIt(L,WindowHasFocus,WaitTime);
end;
until not L;
end; { ScrollUpward }
procedure ScrollDownward;
{}
begin
with MemoDetails do
repeat
MouseStatusWin(L,M,R,X,Y);
if TopNode <> TotalNodes then
begin
if (X = X2) and (Y <= Y2) and (Y >= ElevatorY) and L then
CursorPgDn(MemoDetails);
DelayIt(L,WindowHasFocus,WaitTime);
end;
until not L;
end; { ScrollDownward }
procedure ScrollDragElevator;
{}
var
OldY:byte;
NewActive:longint;
begin
OldY := Y;
with MemoDetails do
repeat
MouseStatusWin(L,M,R,X,Y);
if (X = X2) and (Y < Y2) and (Y > Y1) and (Y <> OldY) and L then
begin
OldY := Y;
if Y = succ(Y1) then
CursorTop(MemoDetails)
else if Y = pred(Y2) then
CursorBottom(MemoDetails)
else
begin
NewActive := TotalNodes * (Y - Y1) div (Y2-Y1);
if NewActive <> pred(TopNode) + CursorPosY then
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
CursorPosY := 1;
TopNode := NewActive;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
DisplayMemo(MemoDetails,HiStatus);
end;
end;
if WindowHasFocus then
WinDrawTop;
end;
until not L;
end; { ScrollElevator }
begin
with MemoDetails do
begin
WaitTime := KeyVars.InitScrollDelay;
repeat
MouseStatusWin(L,M,R,X,Y);
if L and (X = X2) then
begin
if Y = Y1 then
ScrollUpOne
else if Y = Y2 then
ScrollDownOne
else {mouse pressed along scroll bar body}
begin
ElevatorY := GetVScrollBarElevator(Y1,Y2,pred(TopNode)+CursorPosY,TotalNodes);
if ((Y = succ(Y1)) and (Y=ElevatorY) and (pred(TopNode)+CursorPosY > 1))
or (Y > Y1) and (Y < ElevatorY) then
ScrollUpward
else if ((Y = pred(Y2)) and (Y=ElevatorY)
and
(pred(TopNode)+CursorPosY < TotalNodes)
)
or ((Y < Y2) and (Y > ElevatorY)) then
ScrollDownward
else {user is dragging elevator}
ScrollDragElevator;
end;
end;
until not L;
MouseRelease;
end;
end; { MemoScrollBar }
procedure AdjustCursor(var MemoDetails: MemoCfg; X,Y: byte);
{}
begin
with Memodetails do
begin
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
CursorPosY := Y;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
CursorPosX := X;
CheckXandMove(MemoDetails);
end;
end; { AdjustCursor }
procedure MouseDown(var MemoDetails: MemoCfg;StartX,StartY: byte);
{}
var L,M,R: boolean;
AnchorY,
LastY: longint;
AnchorX,
LastX,
X,Y:byte;
function Backward: boolean;
{}
begin
with Memodetails do
Backward := (Y + pred(TopNode) < LastY)
or
(
(Y + pred(TopNode) = LastY)
and
(X + pred(FirstCharPos) < LastX)
);
end; { Backward }
begin
with MemoDetails do
begin
X := StartX;
Y := StartY;
AdjustCursor(MemoDetails,X - pred(X1),Y-pred(Y1));
LastX := StartX + pred(FirstCharPos);
LastY := StartY + pred(TopNode);
AnchorX := LastX;
AnchorY := LastY;
{$IFDEF CUTANDPASTE}
Marking := true;
PrepareForMark(MemoDetails);
AnchorX := BlockX1;
AnchorY := BlockY1;
{$ENDIF}
repeat
MouseStatusWin(L,M,R,X,Y);
if L and (X >= X1) and (X < X2) then
begin
if (Y >= Y1) and (Y <= Y2) then
begin
AdjustCursor(MemoDetails,X - pred(X1),Y-pred(Y1));
MarkNewBlock(MemoDetails,backward);
end else
if (Y <= pred(Y1)) and (pred(TopNode) + CursorPosY > 1) then
begin
CursorUp(MemoDetails);
MarkNewBlock(MemoDetails,true);
end else
if (Y >= succ(Y2)) and (pred(TopNode) + CursorPosY < TotalNodes) then
begin
CursorDown(MemoDetails);
MarkNewBlock(MemoDetails,false);
end;
end;
if WindowHasFocus and ((LastX <> X + pred(FirstCharPos))
or (LastY <> Y + pred(TopNode))
) then
WinDrawTop;
{$IFDEF CUTANDPASTE}
SetBlockStartEnd(MemoDetails);
{$ENDIF}
LastX := X + pred(FirstCharPos);
LastY := Y + pred(TopNode);
until not L;
MouseRelease;
end;
end; { MouseDown }
procedure HandleMouse(var MemoDetails: MemoCfg; X,Y: byte);
{}
begin
with MemoDetails do
begin
if InWindow then {convert to local coords}
begin
X := WinLocalX(0,X); {top window has handle of zero}
Y := WinLocalY(0,Y);
end;
if (X = X2) and (TotalNodes > succ(Y2-Y1)) then {hit on scroll bar}
MemoScrollBar(MemoDetails)
else if (X >= X1) and (X < X2) and (Y >= Y1) and (Y <= Y2) then
MouseDown(MemoDetails,X,Y)
else
MouseRelease;
end;
end; { HandleMouse }
procedure HandleZoom(var MemoDetails: MemoCfg; X,Y: byte);
{}
var WP: WStructurePtr;
begin
{First set the memodetails to reflect the revised window dimensions}
WP := WinPtr(0); {top window}
with MemoDetails do
begin
WX1 := WP^.X;
WY1 := WP^.Y;
WX2 := WX1 + pred(WP^.Width);
WY2 := WY1 + pred(WP^.Depth);
SetInnerDimensions(MemoDetails);
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr); {save edits}
if WordWrap then
begin
FirstCharPos := 1;
CursorPosX := 1;
TopNode := 1;
CursorPosY := 1;
MaxWidth := X2-X1;
{$IFDEF WORDWRAP}
WrapFull(Memodetails)
{$ELSE}
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
{$ENDIF}
end else
begin
end;
DisplayMemo(MemoDetails,HiStatus);
if CursorPosY > (Y2-Y1) then
begin
CursorPosY := 1;
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
end;
CheckXandMove(Memodetails);
end;
WinDrawAll;
end; { HandleZoom }
{$IFDEF CUTANDPASTE}
procedure SelectWord(var MemoDetails: MemoCfg; X,Y: byte);
{}
var LastX,EndX: byte;
begin
with MemoDetails do
begin
if InWindow then {convert to local coords}
begin
X := WinLocalX(0,X);
Y := WinLocalY(0,Y);
end;
if (X >= X1) and (X < X2) and (Y >= Y1) and (Y <= Y2) then
begin
X := X - pred(X1);
Y := Y - pred(Y1);
LastX := X;
AdjustCursor(MemoDetails,X,Y);
TurnBlockOff(MemoDetails);
if (LastX = X) and (LineStr[pred(FirstCharPos)+ X] <> ' ') then {wasn't past the end of the line & not a space}
begin
while (LastX > 1) and (LineStr[LastX] <> ' ') do
dec(LastX);
if LineStr[LastX] = ' ' then
inc(LastX);
EndX := LastX;
while (EndX < length(LineStr))
and (LineStr[EndX] <> MemoVars.EndofParaCode)
and (LineStr[EndX] <> ' ')
and not (LineStr[EndX] in PuncChars) do
inc(EndX);
if (LineStr[EndX] = ' ') then
inc(EndX);
{time to highlight the word}
BlockX1 := LastX;
BlockX2 := EndX;
BlockY1 := pred(TopNode) + CursorPosY;
BlockY2 := BlockY1;
if EndX = length(LineStr) then
inc(BlockX2);
DisplayMemo(MemoDetails,HiStatus);
if WindowHasFocus then
WinDrawTop;
MouseRelease;
end;
end;
end;
end; { SelectWord }
{$ENDIF}
{**********************}
{** MemoProcessKey **}
{**********************}
procedure MemoProcessKey(var MemoDetails: MemoCfg;var K:word;X,Y:byte);
{}
var gResult: integer;
begin {MemoProcessKey}
with MemoVars do
with MemoDetails do
begin
CharHook(@Memodetails,K,X,Y); {call user hook}
if InWindow then
if IsWinKey(K,X,Y) then
WinProcessKey(K,X,Y);
{$IFDEF CUTANDPASTE}
Marking := KeyShiftPressed and (K > 265);
if Marking then
PrepareForMark(MemoDetails);
{$ENDIF}
if K = WordRightKey then
begin
CursorRightWord(MemoDetails);
MarkNewBlock(MemoDetails,false);
end
else if K = WordLeftKey then
begin
CursorLeftWord(MemoDetails);
MarkNewBlock(MemoDetails,true);
end
else if K = TopOfWindowKey then
begin
MarkNewBlock(MemoDetails,true);
end
else if K = BotOfWindowKey then
begin
MarkNewBlock(MemoDetails,false);
end
else if K = TopofMemoKey then
begin
CursorTop(MemoDetails);
MarkNewBlock(MemoDetails,true);
end
else if K = BotofMemoKey then
begin
CursorBottom(MemoDetails);
MarkNewBlock(MemoDetails,false);
end
{$IFDEF CUTANDPASTE}
else if K = DeltoScrapKey then
DeltoClipboard(Memodetails)
else if K = CopyToScrapkey then
gResult := CopytoClipboard(Memodetails)
else if K = InsfromScrapKey then
begin
if MemoDetails.WordWrap then
{$IFDEF WORDWRAP}
WWInsFromClipboard(Memodetails)
{$ENDIF}
else
InsFromClipboard(Memodetails);
end
else if K = MarkBlockStartKey then
MarkBlockStart(Memodetails)
else if K = MarkBlockEndKey then
MarkBlockEnd(Memodetails)
else if K = HideBlockKey then
TurnBlockOff(Memodetails)
else if K = DelBlockKey then
EraseBlock(Memodetails)
{$ENDIF}
else
case K of
500: begin
HandleMouse(MemoDetails,X,Y);
end;
540: begin {double click -- highlight the word}
{$IFDEF CUTANDPASTE}
SelectWord(MemoDetails,X,Y);
{$ENDIF}
end;
602: begin {window has been zoomed - refresh}
HandleZoom(MemoDetails,X,Y);
end;
328,428: begin
CursorUp(MemoDetails);
MarkNewBlock(MemoDetails,true);
end;
336,436: begin
CursorDown(MemoDetails);
MarkNewBlock(MemoDetails,false);
end;
337,437: begin
CursorPgDn(MemoDetails);
MarkNewBlock(MemoDetails,false);
end;
329,429: begin
CursorPgUp(MemoDetails);
MarkNewBlock(MemoDetails,true);
end;
335,435: begin
CursorEnd(MemoDetails);
MarkNewBlock(MemoDetails,false);
end;
327,427: begin
CursorHome(MemoDetails);
MarkNewBlock(MemoDetails,true);
end;
333,433: begin
CursorRight(MemoDetails);
MarkNewBlock(MemoDetails,false);
end;
331,431: begin
CursorLeft(MemoDetails);
MarkNewBlock(MemoDetails,true);
end;
else if AllowEdits then
case K of
13,10: ProcessEnter(MemoDetails);
8: BackSpace(MemoDetails);
338: begin
InsertOn := not InsertOn;
InsMode(InsertOn);
end;
339: begin
{$IFDEF WORDWRAP}
if Wordwrap then
WrapDeleteChar(Memodetails)
else
{$ENDIF}
DeleteChar(MemoDetails);
end;
97: begin
ProcessChar(MemoDetails,chr(K));
end;
32..255: ProcessChar(MemoDetails,chr(K));
end;
end;
{$IFDEF CUTANDPASTE}
if not UporDownKey(K) then
TargetPosX := 0;
{$ENDIF}
HindHook(@Memodetails);
end;
end; { MemoProcessKey }
{********************************}
{** Window Editing Functions **}
{********************************}
function Finished(K:word): boolean;
{}
begin
with MemoVars do
Finished := (K = 600)
or (K = EndEditKey)
or (K = EscEditKey);
end; { Finished }
function DisplayMemoEngine(var MemoDetails: MemoCfg;Tit:StrScreen): byte;
{INTERNAL}
var
Handle: integer;
procedure SetWindow;
{}
begin
with MemoDetails do
begin
Handle := WinCreate(WX1,WY1,WX2,WY2,WStyle);
WinSetType(Handle,WiType);
WinSetTitle(Handle,Tit);
WinSetShowNum(Handle,false);
WinSetColor(Handle,WinBorder,Col[MemoBorder1]);
WinSetColor(Handle,WinBorder3DOut,Col[MemoBorder1]);
WinSetColor(Handle,WinBorder3dIn,Col[MemoBorder2]);
WinSetColor(Handle,WinBorderOff,Col[MemoBorderOff]);
WinSetColor(Handle,WinIcons,Col[MemoIcons]);
WinSetColor(Handle,WinBody,Col[MemoHi]);
WinSetColor(Handle,WinTitle,Col[MemoTitle]);
WinPaint(Handle);
end;
end; {SetWindow}
begin
with MemoDetails do
begin
{$IFNDEF WORDWRAP}
if Wordwrap then
begin
MemoWarning(3);
Wordwrap := false;
end;
{$ENDIF}
if WX1 = 0 then {user hasn't set the window}
begin
WX1 := MemoVars.WX1;
WY1 := MemoVars.WY1;
WX2 := MemoVars.WX2;
WY2 := MemoVars.WY2;
end;
SetInnerDimensions(MemoDetails);
SetWindow;
InWindow := true;
{wrap that wrascal}
if Wordwrap then
MaxWidth := X2-X1
else
MaxWidth := MemoVars.DefaultLineLength;
{$IFDEF WORDWRAP}
with Memodetails do
if WordWrap then
WrapFull(MemoDetails)
else
LineStr := GetLine(@Memodetails,pred(TopNode)+CursorPosY);
{$ELSE}
with MemoDetails do
LineStr := GetLine(@MemoDetails,pred(TopNode)+CursorPosY);
{$ENDIF}
WinDisplay(Handle);
DisplayMemo(MemoDetails,HiStatus);
MoveCursor(MemoDetails);
DisplayMemoEngine := handle;
MemoDetails.HindHook(@MemoDetails); {call it once after window is created}
WinDrawAll;
end;
end; { DisplayMemoEngine }
procedure RunMemo(var MemoDetails: MemoCfg;Tit:StrScreen);
{}
var
Handle: integer;
K: word;
X,Y: byte;
begin
Handle := DisplayMemoEngine(MemoDetails,Tit);
with MemoDetails do
begin
InsMode(InsertOn);
{ready for input}
repeat
GetInput;
with KeyVars do
begin
K := LastKey;
X := LastX;
Y := LastY;
end;
MemoProcessKey(MemoDetails,K,X,Y);
WinDrawTop;
until Finished(K);
{time to shut down}
with MemoDetails do
SetLine(@MemoDetails,pred(TopNode)+CursorPosY,LineStr);
WinDispose(Handle);
{$IFDEF CUTANDPASTE}
ClearClipboardBuffer; {empty the buffer before quitting}
{$ENDIF}
MouseRelease;
end; {with}
end; {RunMemo}
{**************************}
{** Desktop Management **}
{**************************}
{$IFOPT F-}
{$DEFINE FOFF}
{$F+}
{$ENDIF}
function MemoCloseHandler(Handle: integer): boolean;
{}
var
WinP: WStructurePtr;
begin
WinP := WinPtr(Handle);
if MemoCfg(Winp^.UserData^).DeskMemoCloseCallBack(Winp^.UserData,Handle) then
begin
WinDispose(Handle);
MemoCloseHandler := true;
end
else
MemoCloseHandler := false;
end; {MemoCloseHandler}
procedure MemoProcessKeyOnDesktop;
{}
var
Handle: integer;
WinP: WStructurePtr;
MDP : ^MemoCfg;
begin
Handle := WinWithFocus;
WinP := WinPtr(Handle);
MDP := Winp^.UserData;
with KeyVars do
begin
MemoProcessKey(MDP^,LastKey,LastX,LastY);
if Finished(LastKey) then
if MemoCloseHandler(Handle) then
{close aborted};
end;
end; { MemoProcessKeyOnDesktop }
procedure MemoFocusHandler(Handle: integer);
{}
var
WinP: WStructurePtr;
begin
WinP := WinPtr(Handle);
with MemoCfg(WinP^.UserData^) do
begin
case DataType of
SourceSLL: SLLSetActiveList(SingleLL(DataSource^));
SourceDLL: DLLSetActiveList(DoubleLL(DataSource^));
end;
end;
end; {MemoFocusHandler}
{$IFDEF FOFF}
{$F-}
{$UNDEF FOFF}
{$ENDIF}
function LaunchMemo(var MemoDetails: MemoCfg;Tit:StrScreen; CloseProc:MemoCloseProc): byte;
{}
var
WinP: WStructurePtr;
Handle: byte;
begin
WinFadeTopWin;
MemoDetails.DeskMemoCloseCallBack := CloseProc;
if WinVars.DesktopFocusStyle <> 0 then
MemoDetails.WStyle := WinVars.DesktopFocusStyle;
Handle := DisplayMemoEngine(Memodetails,Tit);
if Handle = 0 then
MemoSetError(1001)
else
begin
WinP := WinPtr(Handle);
WinP^.ProcessKeyProc := MemoProcessKeyOnDeskTop;
WinP^.CloseWinProc := MemoCloseHandler;
WinP^.ChangeFocusProc := MemoFocusHandler;
WinP^.UserData := @MemoDetails;
end;
WinDrawTop;
CursorOn;
LaunchMemo := Handle;
end; {LaunchMemo}
{*********************************************}
{** U N I T I N I T I A L I Z A T I O N **}
{*********************************************}
procedure MemoDefaultSettings;
{}
begin
with MemoVars do
begin
WordRightKey := 372; {Ctrl-Right}
WordLeftKey := 371; {Ctrl-Left}
TopOfWindowKey := 375; {Ctrl-Home}
BotOfWindowKey := 373; {Ctrl-End}
TopofMemoKey := 388; {Ctrl-PgUp}
BotofMemoKey := 374; {Ctrl-PgDn}
DeltoScrapKey := 263; {Shift-Del}
DelBlockKey := 339; {Del}
CopyToScrapkey := 260; {Ctrl-Ins}
InsfromScrapKey := 261; {Shift-Ins}
MarkBlockStartKey := 321; {F7}
MarkBlockEndKey := 322; {F8}
HideBlockKey := 2; {Ctrl-B}
EndofParaCode := chr(20); {}
EndEditKey := 324; {F10}
EscEditKey := 27; {Esc}
DefaultLineLength := 127;
{window settings}
WinStyle := 4;
WType := WStretch;
WX1 := 10;
WY1 := 5;
WX2 := 70;
WY2 := 20;
{Messages}
ClipboardMsgTitle := ' Clipboard Error ';
WarningTitle := ' Warning ';
ClipboardNoMemoryMsg := 'Insufficient memory to copy text to clipboard.';
ClipboardLowMemoryMsg := 'Low memory -- unable to copy entire text to to clipboard.';
ClipboardLineFullMsg := 'Line too long -- unable to insert text from clipboard.';
MaxLinesMsg := 'Memo is full -- unable insert a line.';
MemoNearlyFullMsg := 'The memo is nearly full. Text on the last line may be erased to make space.';
WordwrapoffMsg := 'Internal error -- program not compiled to support word wrapping!';
LineFullMsg := 'The line is full. Press Ins to change to overtype|mode or delete some characters.';
end;
end; { MemoDefaultSettings }
procedure GoldMEMOInit;
{}
begin
Memovars.LastEcode := 0;
MemodefaultSettings;
MemoVars.Clipboard := nil;
end; {GoldMEMOInit}
begin
GoldMEMOInit;
end.